home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / bbs / bbbbs84.lha / rexx / bbsEd.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-12-12  |  21.7 KB  |  897 lines
  1. /* $VER: bbsEd.rexx 8.3 (12.12.94)
  2. copyright © 1994 Richard Lee Stockton
  3. BBBBS text editor
  4. FREELY DISTRIBUTABLE
  5. */
  6.  
  7. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  8. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  9.  
  10. OPTIONS RESULTS
  11. SIGNAL ON BREAK_C
  12. SIGNAL ON BREAK_E
  13. SIGNAL ON FAILURE
  14. SIGNAL ON SYNTAX
  15.  
  16. PARSE ARG firstedit editarg name maxtime .
  17. IF ~DATATYPE(maxtime,'N') THEN maxtime=3000
  18.  
  19. CALL TIME('R')
  20. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  21.  
  22. def=''
  23. pen2=''
  24. pen3=''
  25. bak2=''
  26. IF colorflag=0 THEN
  27.   DO
  28.     def=''
  29.     pen2=''
  30.     pen3=''
  31.     bak2=''
  32.   END
  33. lineup='1B'x'M'
  34. CR=''
  35. IF ADDRESS()='BAUD' THEN
  36.   DO
  37.     CR='0D'x
  38.     frombb=1
  39.   END
  40. ELSE frombb=0
  41.  
  42. SAY '                  'lineup||CR
  43. SAY '                   'pen3'Entering the EDITOR module..'def||CR
  44. SAY CR
  45. CALL config()
  46. CALL loaddata()
  47. notchanged=1
  48. IF readlines(editarg 1) THEN EXIT 1
  49. finfo=STATEF(editarg)
  50. IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  51. ELSE finfo=''
  52. count=1
  53. DO edloop=1
  54.   IF edcom='S' & bbsprefs.5 THEN  /* spell check */
  55.     DO
  56.       SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
  57.       CALL DELETE(scratch'/SpellFile')
  58.       CALL savelines(scratch'/SpellFile')
  59.       curdir=PRAGMA('D')
  60.       CALL setdir(spellpath)
  61.       CALL SpellChk.rexx(scratch'/SpellFile')
  62.       CALL setdir(curdir)
  63.     END
  64.   ELSE
  65.     DO
  66.       IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
  67.       IF edcom~='L' THEN count=count-linesperpage
  68.       IF count>=lynes.0 | count<1 THEN count=1
  69.       startcount=count
  70.       DO i=startcount TO lynes.0+1
  71.         IF ((i+1-startcount)//linesperpage)=0 & i<lynes.0 THEN
  72.           DO
  73.             pline='                 ['pen3'E'def']dit'
  74.             pline=pline '  ['pen3'RETURN'def']=Continue '
  75.             edcom=getinput(1 1 pline)
  76.             IF edcom~='' THEN LEAVE i
  77.             CALL cleanline(1)
  78.           END
  79.         SAY pen3||RIGHT(i,3)||def lynes.i||CR
  80.         count=count+1
  81.       END
  82.     END
  83.   CALL checktime()
  84.   SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'CR
  85.   pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  86.   IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  87.   pline=pline '['pen3'U'def']pload-Text > '
  88.   edcom=getinput(1 0 pline)
  89.   IF edcom='Q' | edcom='X' THEN edcom=''
  90.   IF edcom='?' THEN
  91.     DO
  92.       SAY CR
  93.       SAY '                   Editor Help'CR
  94.       SAY '----------------------------------------------------------'CR
  95.       SAY '    an empty RETURN tells the editor you are done editing.'CR
  96.       SAY ' 7  edits line number 7, if it exists.'CR
  97.       SAY ' a  Append text to this file.'CR
  98.       SAY ' c  Cut selected line(s) of text to buffer.'CR
  99.       SAY ' i  Insert blank line.'CR
  100.       SAY ' k  Kill (delete) this file.'CR
  101.       SAY ' l  List this file from selected line.'CR
  102.       SAY ' p  Paste buffer contents to selected line number.'CR
  103.       SAY ' r  Replace a phrase or line of text.'CR
  104.       SAY ' s  Spellcheck this file.'CR
  105.       SAY ' u  Upload a textfile to append to this file.'CR
  106.       SAY '----------------------------------------------------------'CR
  107.       SAY CR
  108.       OPTIONS PROMPT ''
  109.       PULL
  110.     END
  111.   IF edcom='K' THEN
  112.     DO
  113.       junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
  114.       IF junk='Y' THEN
  115.         DO
  116.           IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR
  117.           IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
  118.             DO
  119.               IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
  120.                 SAY WORD(lynes.2,4) 'DELETED.'CR
  121.             END
  122.           EXIT 2
  123.         END
  124.     END
  125.   IF edcom='' THEN
  126.     DO
  127.       SAY '                   'pen3'Leaving the EDITOR module.'def||CR
  128.       IF notchanged THEN EXIT 0
  129.       IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
  130.         EXIT 1
  131.       CALL DELETE(editarg)
  132.       IF savelines(editarg) THEN EXIT 1
  133.       CALL DELAY(28)
  134.       IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
  135.       SAY pen3'                        Changes saved.'def||CR
  136.       EXIT 0
  137.     END
  138.   ELSE IF edcom='C' THEN  /* Cut */
  139.     DO
  140.       firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
  141.       IF firstnum='' THEN ITERATE edloop
  142.       dash=POS('-',firstnum)
  143.       IF dash>0 THEN
  144.         DO
  145.           lastnum=STRIP(SUBSTR(firstnum,dash+1))
  146.           firstnum=STRIP(LEFT(firstnum,dash-1))
  147.         END
  148.       ELSE lastnum=firstnum
  149.       IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
  150.         DO
  151.           junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
  152.           ITERATE edloop
  153.         END
  154.       IF lastnum>lynes.0 THEN lastnum=lynes.0
  155.       IF firstnum<firstedit THEN
  156.         DO
  157.           SAY '*** You are not authorized to delete that line!'CR
  158.           SAY CR
  159.           ITERATE edloop
  160.         END
  161.       IF firstnum>lastnum THEN
  162.         DO
  163.           SAY '*** Input error!  First number larger than last number.'CR
  164.           ITERATE edloop
  165.         END
  166.       notchanged=0
  167.       numdiff=lastnum+1-firstnum
  168.       pasted.=''
  169.       pasted.0=numdiff
  170.       k=0
  171.       DO i=firstnum TO lynes.0
  172.         j=i+numdiff
  173.         k=k+1
  174.         IF k<=numdiff THEN pasted.k=lynes.i
  175.         lynes.i=lynes.j
  176.         lynes.j=''
  177.       END
  178.       lynes.0=lynes.0-numdiff
  179.       count=1
  180.     END
  181.   ELSE IF edcom='A' THEN  /* append */
  182.     DO
  183.       IF frombb THEN temp='File'
  184.       ELSE temp='LOCAL'
  185.       CALL writebuffer(scratch'/Editor'temp)
  186.       notchanged=0
  187.     END
  188.   ELSE IF edcom='U' THEN  /* Upload a textfile to append */
  189.     DO
  190.       CALL txup(editarg)
  191.       notchanged=0
  192.     END
  193.   ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
  194.     DO
  195.       IF DATATYPE(edcom,'W') THEN
  196.         DO
  197.           ednum=edcom
  198.           edcom='R'
  199.         END
  200.       ELSE
  201.         DO
  202.           line=pen3'   '
  203.           IF edcom='L' | edcom='P' THEN line=line'Starting '
  204.           line=line'Line Number? > 'def
  205.           ednum=getinput(1 0 line)
  206.         END
  207.       IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
  208.       IF ednum>(lynes.0+1) THEN ITERATE edloop
  209.       IF edcom='L' THEN
  210.         DO
  211.           count=ednum
  212.           ITERATE edloop
  213.         END
  214.       IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
  215.         DO
  216.           IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
  217.             DO
  218.               filenum=STRIP(WORD(lynes.1,2))
  219.               keywords=edkeywords(editarg)
  220.               lynes.1=LEFT(lynes.1,21) keywords
  221.               suf='LOCAL'
  222.               IF frombb THEN suf=''
  223.               t=GETCLIP('BBS_FileChange'suf)
  224.               CALL SETCLIP('BBS_FileChange'suf,STRIP(t filenum))
  225.               CALL SETCLIP('BBS_Keywords_'filenum,keywords)
  226.               notchanged=0
  227.               ITERATE edloop
  228.             END
  229.         END
  230.       IF ednum<firstedit THEN
  231.         DO
  232.           SAY '*** You are not authorized to alter that line!'CR
  233.           SAY CR
  234.           ITERATE edloop
  235.         END
  236.       IF edcom='R' THEN   /* replace */
  237.         DO
  238.           SAY '   Now reads:'CR
  239.           SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
  240.           OPTIONS PROMPT pen3'........Search text? >'def
  241.           PARSE PULL stext
  242.           IF LENGTH(stext)=0 THEN
  243.             DO
  244.               IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
  245.                 ITERATE edloop
  246.               lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
  247.               notchanged=0
  248.               ITERATE edloop
  249.             END
  250.           found=POS(UPPER(stext),UPPER(lynes.ednum))
  251.           IF found=0 THEN
  252.             DO
  253.               SAY CR
  254.               SAY stext' was not found!'CR
  255.               SAY CR
  256.               ITERATE edloop
  257.             END
  258.           OPTIONS PROMPT pen3'...Replacement text? >'def
  259.           PARSE PULL rtext
  260.           lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
  261.           lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
  262.           IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
  263.             DO
  264.               PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
  265.               PARSE VAR lynes.3 . 'Lib:' libnam
  266.               filenum=STRIP(filenum)
  267.               newc=files.filenum.0
  268.               libnum=finddirnum(libnam)
  269.               alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
  270.               alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
  271.               alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
  272.               alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
  273.               savefileflag=1
  274.             END
  275.           SAY 'Done.'CR
  276.           SAY CR
  277.           notchanged=0
  278.         END
  279.       ELSE IF edcom='I' THEN  /* insert */
  280.         DO
  281.           DO i=lynes.0 TO ednum BY -1
  282.             j=i+1
  283.             lynes.j=lynes.i
  284.           END
  285.           lynes.ednum=''
  286.           notchanged=0
  287.           lynes.0=lynes.0+1
  288.           OPTIONS PROMPT pen3||RIGHT(ednum,2)'>'def
  289.           PARSE PULL lynes.ednum
  290.         END
  291.       ELSE IF edcom='P' THEN   /* paste */
  292.         DO
  293.           DO i=lynes.0 TO ednum BY -1
  294.             j=i+pasted.0
  295.             lynes.j=lynes.i
  296.           END
  297.           DO k=1 TO pasted.0
  298.             kk=ednum+k-1
  299.             lynes.kk=pasted.k
  300.           END
  301.           notchanged=0
  302.           lynes.0=lynes.0+pasted.0
  303.         END
  304.     END
  305. END
  306. EXIT 0
  307.  
  308.  
  309. writebuffer:
  310. PARSE ARG bufname .
  311. IF frombb THEN Capture OFF
  312. CALL DELETE(bufname)
  313. startnum=lynes.0+1
  314. SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
  315. IF EXISTS(bufname) THEN
  316.   DO
  317.     CALL DELAY(56)
  318.     CALL DELETE(bufname)
  319.     CALL DELAY(56)
  320.   END
  321. IF frombb THEN
  322.   DO
  323.     CaptWrap 74
  324.     Send pen3
  325.     Capture bufname
  326.     Send def
  327.     TimeOut 120
  328.     DO bufloop=1
  329.       Wait '/E,/S,RING,NO CARRIER'
  330.       Status 'L'
  331.       test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  332.       CALL checkdcd()
  333.       IF test='/E' | test='/S' | test='/X' THEN LEAVE bufloop
  334.     END
  335.     IF test~='/X' THEN Send '\b\b'pen3
  336.     Capture OFF
  337.     CALL checkdcd()
  338.     TimeOut maxidle
  339.     SAY def||CR
  340.     CALL readlines(bufname startnum)
  341.     CALL wrapbuf(startnum)
  342.     QUEUE CR
  343.   END
  344. ELSE
  345.   DO
  346.     OPTIONS PROMPT ''
  347.     DO bufloop=startnum
  348.       PARSE PULL line
  349.       IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
  350.         LEAVE bufloop
  351.       lynes.bufloop=line
  352.     END
  353.     lynes.0=bufloop-1
  354.     CALL wrapbuf(startnum)
  355.     CALL DELETE(bufname)
  356.     CALL savelines(bufname)
  357.     SAY
  358.   END
  359. RETURN
  360.  
  361.  
  362. wrapbuf:
  363. ARG startnum .
  364. CALL cleanline(1)
  365. SAY pen3'Wordwrapping...'def||CR
  366. lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
  367. lynes.startnum=cleanstring(2':'lynes.startnum)
  368. DO wi=startnum WHILE wi<=lynes.0
  369.   wj=wi+1
  370.   lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  371.   lynes.wj=cleanstring(2':'lynes.wj)
  372.   IF LENGTH(lynes.wi)>75 THEN
  373.     DO
  374.       testchar=''
  375.       IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
  376.       IF testchar=' ' | testchar='.' | testchar=':' THEN
  377.         DO
  378.           DO wjj=lynes.0 TO wi+1 BY -1
  379.             wk=wjj+1
  380.             lynes.wk=lynes.wjj
  381.           END
  382.           lynes.wj=''
  383.           lynes.0=lynes.0+1
  384.         END
  385.       DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
  386.         IF WORDS(lynes.wi)=1 THEN
  387.           lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
  388.         lynes.wj=WORD(lynes.wi,wl) lynes.wj
  389.         lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
  390.       END
  391.     END
  392. END
  393. RETURN
  394.  
  395.  
  396. txup:
  397. PARSE ARG uparg .
  398. IF frombb THEN
  399.   DO
  400.     SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
  401.     pline='Are you SURE your file is un-compressed text? (Ny) > '
  402.     IF getinput(1 1 pline)~='Y' THEN RETURN
  403.   END
  404. savearg=arg
  405. arg='Upload'
  406. arg2='tempfile1'
  407. IF frombb THEN arg=arg'File'
  408. ELSE
  409.   DO
  410.     arg=arg'LOCAL'
  411.     arg2=arg2'LOCAL'
  412.   END
  413. curdir=PRAGMA('D')
  414. CALL setdir(scratch)
  415. CALL DELETE(arg)
  416. CALL DELETE(arg2)
  417. IF uload()=0 THEN
  418.   DO
  419.     ADDRESS COMMAND 'C:copy' uparg scratch'/'arg2 'CLONE'
  420.     CALL DELETE(uparg)
  421.     ADDRESS COMMAND 'C:join' scratch'/'arg2 PRAGMA('D')'/'arg 'AS' uparg
  422.   END
  423. CALL readlines(uparg 1)
  424. notchanged=0
  425. CALL setdir(curdir)
  426. arg=savearg
  427. RETURN
  428.  
  429.  
  430. chpro:
  431. arg=UPPER(LEFT(arg,1))
  432. IF(arg='') THEN
  433.   DO
  434.     SAY CR
  435.     SAY '['pen3'W'def']- WXModem'CR
  436.     SAY '['pen3'X'def']- XModem-CRC'CR
  437.     SAY '['pen3'K'def']- XModem-1K'CR
  438.     SAY '['pen3'Y'def']- YModem'CR
  439.     SAY '['pen3'G'def']- YModem-G'CR
  440.     SAY '['pen3'Z'def']- ZModem'CR
  441.     SAY CR
  442.     arg=getinput(1 0 STRIP(protocol) '> ')
  443.  END
  444. IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
  445. Set arg
  446. Status Transfer
  447. protocol=STRIP(RESULT)
  448. SAY protocol||CR
  449. RETURN
  450.  
  451.  
  452. uload:
  453. CALL bbsspace(12)
  454. SAY CR
  455. IF bbsk<1 THEN
  456.   DO
  457.     line='Upload area is full!'
  458.     CALL send2log(line)
  459.     SAY pen3||line||def||CR
  460.     RETURN 1
  461.   END
  462. IF frombb THEN
  463.   DO
  464.     checkproto='T'
  465.     targ=arg
  466.     DO WHILE checkproto='T'
  467.       arg=''
  468.       SAY CR
  469.       SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  470.       pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  471.       pline=pline '['pen3'U'def']pload (qtU) > '
  472.       checkproto=getinput(1 1 pline)
  473.       IF checkproto='Q' THEN RETURN 1
  474.       IF checkproto='T' THEN CALL chpro()
  475.     END
  476.     arg=targ
  477.     IF bbsprefs.13~=1 THEN ADDRESS AREXX bbsSounds.rexx bbspath'/Sounds' 'UPLOAD'
  478.     uploadtime=TIME('E')
  479.     CALL checktime()
  480.     SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  481.     DownLoad arg
  482.     IF RC>0 THEN RETURN 2
  483.     IF bbsXferStats.baud(14 arg colorflag protocol) THEN RETURN 2
  484.     rbytes=WORD(STATEF(arg),2)
  485.     IF rbytes<1 THEN
  486.       DO
  487.         CALL DELETE(arg)
  488.         RETURN 2
  489.       END
  490.     temp=''
  491.     DO WHILE temp~='N' & temp~='Y'
  492.       temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
  493.     END
  494.     IF temp='N' THEN RETURN 2
  495.   END
  496. ELSE
  497.   DO
  498.     frompath=GETCLIP('BBS_frompath')
  499.     IF frompath='' THEN frompath='RAM:'
  500.     fdir=''
  501.     DO loop=1
  502.       fromfile=GetFile(150,36,frompath,'',' Select File to Upload ')
  503.       IF fromfile='' THEN RETURN 1
  504.       IF EXISTS(fromfile) THEN LEAVE loop
  505.       SAY
  506.       SAY fromfile 'does not exist!'
  507.     END
  508.     ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D') 'CLONE'
  509.     rbytes=WORD(STATEF(fromfile),2)
  510.     x=LASTPOS('/',fromfile)
  511.     IF x=0 THEN x=POS(':',fromfile)
  512.     IF x>0 THEN
  513.       DO
  514.         arg=SUBSTR(fromfile,x+1)
  515.         fdir=LEFT(fromfile,x)
  516.         IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
  517.         CALL SETCLIP('BBS_frompath',fdir)
  518.       END
  519.     ELSE arg=fromfile
  520.   END
  521. IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  522.   DO
  523.     SAY CR
  524.     SAY pen3'***'def arg pen3'failed archive check!'def||CR
  525.     SAY CR
  526.     temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
  527.     IF temp~='Y' THEN
  528.       DO
  529.         CALL DELETE(arg)
  530.         SAY CR
  531.         RETURN 2
  532.       END
  533.   END
  534. IF ~frombb THEN RETURN 0
  535. CALL bytes2user(14 rbytes)
  536. ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
  537. IF bbsprefs.9 & name~=sysop THEN
  538.   DO
  539.     newufile=bbspath'EMail/'sysop'/NEW_FILES'
  540.     IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  541.     ELSE
  542.       DO
  543.         ok=OPEN(f,newufile,'W')
  544.         IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') 
  545.       END
  546.     IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
  547.     CALL CLOSE(f)
  548.   END
  549. RETURN 0
  550.  
  551.  
  552. bytes2user:
  553. PARSE ARG indx bytes .
  554. tfiles=WORD(data.indx,1)
  555. tbytes=WORD(data.indx,3)
  556. IF ~DATATYPE(tfiles,'W') THEN tfiles=0
  557. IF ~DATATYPE(tbytes,'W') THEN tbytes=0
  558. tbytes=tbytes+bytes
  559. tfiles=tfiles+1
  560. IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
  561. ELSE data.indx='1 file' bytes 'bytes.'
  562. data.indx=data.indx DATE()
  563. CALL savedata(0)
  564. RETURN
  565.  
  566.  
  567. bbsspace:
  568. ARG tabspace .
  569. ADDRESS COMMAND 'C:info >'scratch'/infout' bbsdevice
  570. ok=OPEN(f,scratch'/infout','R')
  571. IF ok=0 THEN RETURN 20
  572. line=READLN(f)
  573. line=READLN(f)
  574. line=READLN(f)
  575. line=READLN(f)
  576. CALL CLOSE(f)
  577. IF tabspace<14 THEN SAY CR
  578. bbsk=WORD(line,4)
  579. IF ~DATATYPE(bbsk,'N') THEN
  580.   DO
  581.     line=bbsdevice 'is not an info compatible device!'
  582.     CALL send2log(line)
  583.     SAY pen3||line||def||CR
  584.     bbsk=0
  585.     RETURN
  586.   END
  587. bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
  588. IF bbsk<1 THEN bbsk=0
  589. SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
  590. RETURN
  591.  
  592.  
  593. comma:
  594. ARG num .
  595. t=''
  596. x=POS('.',num)
  597. IF x>0 THEN t=SUBSTR(num,x)
  598. num=num%1
  599. dgt=LENGTH(num)
  600. numtext=''
  601. IF dgt>3 THEN numtext=','RIGHT(num,3)
  602. IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
  603. IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
  604. IF dgt>12 THEN
  605.   DO
  606.     numtext=','LEFT(RIGHT(num,12),3)||numtext
  607.     numtext=LEFT(num,dgt-12)||numtext
  608.   END
  609. ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
  610. ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
  611. ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
  612. ELSE numtext=num
  613. RETURN numtext||t
  614.  
  615.  
  616. loaddata:
  617. IF name='' THEN RETURN 0
  618. IF OPEN(f,bbspath'USERS/'name,'R')=0 THEN RETURN 0
  619. data.=''
  620. DO i=1
  621.   line=READLN(f)
  622.   IF EOF(f) THEN BREAK
  623.   data.i=line
  624. END
  625. data.0=i-1
  626. CALL CLOSE(f)
  627. protocol=data.6
  628. IF ~DATATYPE(data.7,'W') | data.7<5 | ~frombb THEN data.7=20
  629. linesperpage=data.7
  630. IF ~frombb THEN linesperpage=20
  631. IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
  632. ELSE colorflag=0
  633. level=data.20
  634. RETURN 1
  635.  
  636.  
  637. savedata:
  638. IF OPEN(f,bbspath'USERS/'name,'W')=0 THEN RETURN
  639. IF data.0<27 THEN data.0=27
  640. DO i=1 TO data.0
  641.   CALL WRITELN(f,data.i)
  642. END
  643. CALL CLOSE(f)
  644. SAY 'User' name 'has been updated.'CR
  645. IF frombb THEN CALL SETCLIP('BBS_interpret','CALL loaddata()')
  646. RETURN
  647.  
  648.  
  649. edkeywords:
  650. PARSE ARG kwarg
  651. templine=''
  652. DO WHILE LENGTH(templine)<3
  653.   SAY CR
  654.   SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
  655.   SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
  656.   SAY '    Note that only the first 32 characters will be used.'CR
  657.   SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR
  658.   templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  659.   templine=cleanstring('0:'templine)
  660.   templine=STRIP(LEFT(templine,32))
  661.   SAY CR
  662. END
  663. RETURN templine
  664.  
  665.  
  666. readlines:
  667. CALL CLOSE(f)
  668. PARSE ARG tempname readstart .
  669. IF OPEN(f,tempname,'R')=0 THEN RETURN 1
  670. IF readstart<2 THEN lynes.=''
  671. DO ri=readstart
  672.   line=READLN(f)
  673.   IF EOF(f) THEN BREAK
  674.   lynes.ri=line
  675. END
  676. lynes.0=ri-1
  677. CALL CLOSE(f)
  678. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
  679. END
  680. lynes.0=ri
  681. RETURN 0
  682.  
  683.  
  684. savelines:
  685. PARSE ARG tempname .
  686. IF OPEN(f,tempname,'W')=0 THEN
  687.   DO
  688.     line='***' tempname 'failed to open for saving!'
  689.     CALL send2log(line)
  690.     SAY line||CR
  691.     RETURN 1
  692.   END
  693. DO wi=1 TO lynes.0
  694.   CALL WRITELN(f,lynes.wi)
  695. END
  696. CALL CLOSE(f)
  697. RETURN 0
  698.  
  699.  
  700. setdir:
  701. PARSE ARG tempdir
  702. CALL PRAGMA('D',STRIP(tempdir))
  703. directory=PRAGMA('D')
  704. IF frombb THEN Data directory
  705. slash=LASTPOS('/',directory)
  706. IF slash=0 THEN slash=LASTPOS(':',directory)
  707. plaindir=directory
  708. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  709. RETURN
  710.  
  711.  
  712. config:
  713. arg='s:CONFIG.BBS'
  714. IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
  715. IF readlines(arg 1) THEN
  716.   DO
  717.     SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
  718.     EXIT 666
  719.   END
  720. bbsdevice=WORD(lynes.4,1)
  721. sysoplevel=WORD(lynes.5,1)
  722. bbspath=WORD(lynes.6,1)
  723. IF ~EXISTS(bbspath) THEN
  724.   DO
  725.     SAY bbspath 'does not exist!'CR
  726.     EXIT 666
  727.   END
  728. testchar=RIGHT(bbspath,1)
  729. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  730. SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
  731. bbsprefs.=''
  732. DO i=16 TO 41
  733.   j=i-15
  734.   bbsprefs.j=STRIP(WORD(lynes.i,1))
  735. END
  736. spellpath=WORD(lynes.9,1)
  737. IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  738.   DO
  739.     SAY spellpath 'does not exist!'CR
  740.     bbsprefs.5=0
  741.   END
  742. IF bbsprefs.10 THEN scratch=bbspath'Scratch'
  743. ELSE scratch='RAM:Scratch'
  744. CALL MAKEDIR(scratch)
  745. RETURN
  746.  
  747.  
  748. send2log:
  749. PARSE ARG sendline
  750. logfile=bbspath'Logs/log.'DATE('S')
  751. IF ~OPEN('log',logfile,'A') THEN
  752.   DO
  753.     IF ~OPEN('log',logfile,'W') THEN
  754.       DO
  755.         SAY 'failed to open log file'
  756.         RETURN
  757.      END
  758.   END
  759. CALL WRITELN('log','bbsEd:' sendline)
  760. CALL CLOSE('log')
  761. RETURN
  762.  
  763.  
  764. checktime:
  765. IF ~frombb THEN RETURN
  766. IF TIME('E')>maxtime THEN EXIT 0
  767. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  768. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  769. CALL checkdcd()
  770. RETURN
  771.  
  772.  
  773. cleanline:
  774. ARG lflag .
  775. IF nonstop=0 & clr~='' THEN
  776.   DO
  777.     Send clr
  778.     RETURN
  779.   END
  780. IF colorflag~=1 & lflag=1 THEN RETURN
  781. cline=lineup||LEFT(' ',78)
  782. IF lflag=1 THEN cline=cline||lineup
  783. SAY cline||CR
  784. RETURN
  785.  
  786.  
  787. getinput:
  788. PARSE ARG upflag' 'oneflag' 'pline
  789. CALL checkdcd()
  790. OPTIONS PROMPT pline
  791. PARSE PULL inarg
  792. inarg=STRIP(inarg)
  793. IF upflag THEN inarg=UPPER(inarg)
  794. IF oneflag THEN inarg=LEFT(inarg,1)
  795. inarg=cleanstring(0':'inarg)
  796. RETURN inarg
  797.  
  798.  
  799. strip_ansi:
  800. PARSE ARG aline 
  801. n=POS('1B'x,aline)
  802. DO WHILE n>0
  803.   DO k=2
  804.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  805.       leave k
  806.   END
  807.   aline=DELSTR(aline,n,k+1)
  808.   n=POS('1B'x,aline)
  809. END
  810. RETURN aline
  811.  
  812.  
  813. cleanstring:
  814. PARSE ARG nflag':'cstr
  815. IF nflag=1 THEN
  816.   DO
  817.     cstr=COMPRESS(cstr,"'`")
  818.     cstr=TRANSLATE(cstr,,namemask)
  819.     cstr=SPACE(cstr,1,'_')
  820.     RETURN cstr
  821.   END
  822. bot=XRANGE(,'1F'x)
  823. IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  824. ELSE cstr=strip_ansi(cstr)
  825. top=XRANGE('7F'x)
  826. cstr=COMPRESS(cstr,bot||top)
  827. IF nflag=0 THEN cstr=STRIP(cstr)
  828. RETURN cstr
  829.  
  830.  
  831. checkdcd:
  832. IF ~frombb THEN RETURN
  833. dcd
  834. IF RC=0 THEN
  835.   DO
  836.     DO dcds=1 TO 3  /* 5 second delay */
  837.       CALL DELAY(50)
  838.       dcd
  839.       IF RC~=0 THEN RETURN
  840.     END
  841.     dcd
  842.     IF RC=0 THEN EXIT 0
  843.   END
  844. xmsg=GETCLIP('BBS_MESSAGE')
  845. Capture
  846. IF RC=0 & xmsg~='' THEN
  847.   DO
  848.     CALL SETCLIP('BBS_MESSAGE')
  849.     SAY CR
  850.     SAY bak2' Message From BBBBS: 'def||CR
  851.     SAY xmsg||CR
  852.     SAY CR
  853.     CALL waiting()
  854.   END
  855. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT 0
  856. RETURN
  857.  
  858.  
  859. waiting:
  860. CALL checktime()
  861. IF waitchar='Q' THEN
  862.   DO
  863.     waitchar=''
  864.     RETURN
  865.   END
  866. waitchar=''
  867. IF nonstop=1 THEN RETURN
  868. OPTIONS PROMPT pen3'                       RETURN=Continue  'def
  869. PULL waitchar
  870. RETURN
  871.  
  872.  
  873. BREAK_E:
  874. i=999999
  875. ri=999999
  876. wi=999999
  877. RETURN
  878.  
  879.  
  880. BREAK_C:
  881. EXIT 2
  882.  
  883.  
  884. FAILURE:
  885. SYNTAX:
  886. lin.1=''ERRORTEXT(RC)''
  887. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  888. lin.3=SIGL ''SOURCELINE(SIGL)''
  889. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  890. DO er=1 TO 4
  891.   IF level>sysoplevel | ~frombb THEN SAY 'bbsEd:' lin.er||CR
  892.   IF frombb THEN CALL send2log(lin.er)
  893. END
  894. EXIT 2
  895.  
  896. /* bbsEd.rexx */
  897.